﻿Option Explicit On
Option Strict Off

Imports System.Data
Imports System.Diagnostics
Imports Microsoft.SharePoint
Imports Microsoft.SharePoint.WebControls

Imports Microsoft.VisualBasic
Imports System
Imports System.Web.UI.WebControls

Imports System.Runtime.InteropServices
Imports System.Web.UI
Imports System.Web.UI.WebControls.WebParts
Imports System.Xml
Imports System.Xml.XPath
Imports System.Xml.Serialization
Imports Microsoft.SharePoint.WebPartPages

Imports System.Collections.Generic
Imports System.ComponentModel
Imports Microsoft.SharePoint.Utilities

#Region "COMMENTS"
' Please Mantain this code area , modifications are alowed under GPL License
' Version 0.8   31-3-2009
' Author : Roberto Marcos Asensio (www.robertomarcos.com)
' Codeplex Project :http://listgenwp.codeplex.com
' Support Blog : http://sharepointworks.blogspot.com
' Notes: You may need to enter in listedit mode , in each lookup field and save to make NEW and Edit Form work properly
'Todo: Make Field Type a ComboBox and make some validations in fields
'Todo: In Insert action, the required field is missing and the insert migth be unclear.
#End Region



Namespace ListGenWP
    <Guid("bf42a193-94d9-4151-99b3-2468012d75cc")> _
    Public Class SPListGenerator
        Inherits Microsoft.SharePoint.WebPartPages.WebPart

        Private _UserControl As String = "~/_controltemplates/ListGeneratorWP.ascx"
        Dim _Control As Control
        Dim WithEvents btnCreateList As New Microsoft.SharePoint.WebControls.FormButton

        Dim mensaje As New LiteralControl()
        Dim cursite As SPWeb = SPControl.GetContextWeb(Context)


        Dim nav As XPathNavigator
        Dim docNav As XPathDocument


        Protected Overrides Sub CreateChildControls()
            MyBase.CreateChildControls()
            btnCreateList.Text = "Crear Listas"
            btnCreateList.ControlMode = SPControlMode.Display

            Call CreaXMLSiNoExiste()


            Try
                Me.Controls.Add(btnCreateList)
                Me.Controls.Add(mensaje)
                'Me.Controls.Add(New LiteralControl(Context.Request.Url.AbsoluteUri))
                _Control = TryCast(Me.Page.LoadControl(_UserControl), UserControl)
                '    '_Control = Me.Page.LoadControl(_UserControl)
            Catch ex As Exception
                _Control = New LiteralControl(String.Format("Ajuste el parametro de UserControl, <a href=""javascript:MSOTlPn_ShowToolPaneWrapper('{0}','{1}','{2}');"">Abrir edición de Propiedades de WebPart</a> y escribir la ruta al webcontrol (*.ascx)<br>" & ex.Message, 1, 129, Me.ID))
            End Try


            If Not _Control Is Nothing Then
                Me.Controls.Add(_Control)
            End If


        End Sub

        <WebBrowsable(True), Personalizable(PersonalizationScope.User), _
        WebDisplayName("User Control (*.ascx)"), _
        FriendlyName("User Control (*.ascx)"), Category("User Control"), _
        WebDescription("Ruta a un control de Usuario (*.ascx)")> _
        Public Property UserControl() As String
            Get
                Return _UserControl
            End Get
            Set(ByVal value As String)
                _UserControl = value
            End Set
        End Property

        Private Sub CreaXMLSiNoExiste()
            Const sXML_Listas As String = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
                "<Listas> " & _
                  "<Lista name=""Lista1"" Crear=""True"">" & _
                   " <campo name=""CODIGO"" type=""text"" length=""20"" Requerido=""True"" list="""" field="""" />" & _
                   " <campo name=""DESCRIPCION"" type=""text"" length=""110"" list="""" field="""" Requerido=""False"" />" & _
                  "</Lista>" & _
                  "<Lista name=""Lista2"" Crear=""True"">" & _
                  "  <campo name=""CODIGO"" type=""text"" length=""20"" Requerido=""True"" list="""" field="""" />" & _
                  "  <campo name=""DESCRIPCION"" type=""text"" length=""100"" Requerido=""False"" list="""" field="""" />" & _
                  "  <campo name=""campolookup"" type=""lookup"" list=""Lista1"" field=""DESCRIPCION"" Requerido=""False"" length="""" />" & _
                 " </Lista>" & _
                "</Listas>"

            Dim ws As SPWeb = SPControl.GetContextWeb(Context)

            ws.AllowUnsafeUpdates = True
            MiscTools.crea_fichero_Sharepoint(ws, Replace(SPControl.GetContextWeb(Context).ServerRelativeUrl & "/ListasDef.xml", "//", "/"), sXML_Listas, False)

        End Sub



        Private Sub btnCreateList_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnCreateList.Click

            Dim docNav As XmlDocument

            Dim rutaxml As String = SPControl.GetContextWeb(Context).ServerRelativeUrl
            If rutaxml = "/" Then
                rutaxml = rutaxml & "ListasDef.xml"
            Else
                rutaxml = rutaxml & "/ListasDef.xml"
            End If


            Dim strXml As String = SPControl.GetContextWeb(Context).GetFileAsString(rutaxml)

            docNav = New XmlDocument()

            docNav.LoadXml(strXml)

            Try
                Call CreaListas(docNav)
            Catch ex As Exception
                Me.Controls.Clear()
                Me.Controls.Add(New LiteralControl(String.Format("Se ha producido un error, recarge la pagina o , <a href=""javascript:MSOTlPn_ShowToolPaneWrapper('{0}','{1}','{2}');"">Abrir edición de Propiedades de WebPart</a> <br><b>ERROR:</b><br>" & ex.Message, 1, 129, Me.ID)))
            End Try

            mensaje.Text = "OK. Se han creado las listas."
        End Sub

        Private Sub CreaLista(ByVal nombre As String)
            cursite.Lists.Add(nombre, nombre, SPListTemplateType.GenericList)
        End Sub


        Private Sub CreaListas(ByVal oXML As XmlDocument)
            Dim lst As XmlNode, campo As XmlNode
            Dim listas As XmlNodeList, campos As XmlNodeList
            Dim root As SPWeb = SPControl.GetContextWeb(Context)
            Dim curSite As SPWeb = SPContext.Current.Web
            root = SPControl.GetContextWeb(Context)

            If root Is Nothing Then
                Throw New Exception("Could not find SharePoint root web site!")
            End If

            listas = oXML.SelectNodes("/Listas/Lista")
            For Each lst In listas
                Dim tmplist As SPList
                ' Creamos la lista si esta marcada como crear
                If lst.Attributes("Crear").Value.ToLower = "true" Then
                    Try
                        tmplist = curSite.Lists(lst.Attributes("name").Value)
                        'tmplist.Delete() ¡¡ ESTO PROVOCA ACCIDENTES, CAMBIA LAS GUIDs Y EN CONSECUENCIA BORRA LAS PAGINAS CUSTOM!!
                        mensaje.Text = "La lista <b>" & tmplist.ToString & "</b> ya existe, eliminela para crearla de nuevo."
                        tmplist.Update()
                        curSite.Lists.Add(lst.Attributes("name").Value, lst.Attributes("name").Value, SPListTemplateType.GenericList)
                        tmplist = curSite.Lists(lst.Attributes("name").Value)
                    Catch
                        'SPSecurity.RunWithElevatedPrivileges()
                        curSite.Lists.Add(lst.Attributes("name").Value, lst.Attributes("name").Value, SPListTemplateType.GenericList)
                        tmplist = curSite.Lists(lst.Attributes("name").Value)

                    End Try
                    campos = lst.SelectNodes("campo") ' Seleccionamos los campos que tenga la lista
                    Dim bPrimerCampo As Boolean = True
                    For Each campo In campos

                        If bPrimerCampo = True Then
                            'renombrar el elemento title
                            Dim fld As SPField = tmplist.Fields.GetFieldByInternalName("Title")

                            fld.Title = campo.Attributes("name").Value
                            fld.DisplaySize = campo.Attributes("length").Value
                            fld.Required = True ' El primero siempre es obligatorio
                            fld.Update()
                            tmplist.Update()
                        Else
                            ' crear elemento del tipo que corresponda
                            'Dim campoText As SPFieldText
                            'Dim campoNumero As SPFieldNumber
                            ' Dim campoMoneda As SPFieldCurrency
                            '  Dim campoLookup As SPFieldLookup
                            ' Dim campoFecha As SPFieldDateTime


                            Select Case LCase(campo.Attributes("type").Value)
                                Case "text"

                                    tmplist.Fields.Add(campo.Attributes("name").Value, SPFieldType.Text, False)
                                    tmplist.Fields(campo.Attributes("name").Value).DisplaySize = IIf(campo.Attributes("length").Value = String.Empty, 10, campo.Attributes("length").Value)
                                    tmplist.Update()

                                Case "number"
                                    tmplist.Fields.Add(campo.Attributes("name").Value, SPFieldType.Number, False)
                                    tmplist.Fields(campo.Attributes("name").Value).DefaultValue = 0
                                    tmplist.Update()
                                Case "currency"
                                    tmplist.Fields.Add(campo.Attributes("name").Value, SPFieldType.Currency, False)
                                    tmplist.Update()
                                Case "lookup"
                                    tmplist.Fields.AddLookup(campo.Attributes("name").Value, curSite.Lists(campo.Attributes("list").Value).ID, IIf(campo.Attributes("Requerido").Value = "True", True, False)) 'curSite.Lists(campo.Attributes("list").Value).Fields(campo.Attributes("field").Value).Id
                                    tmplist.Update()
                                    'Ajustamos el valor del lookupfield
                                    Dim tmp As SPFieldLookup = CType(tmplist.Fields(campo.Attributes("name").Value), SPFieldLookup)
                                    tmp.LookupField = campo.Attributes("field").Value
                                    tmp.Description = campo.Attributes("name").Value
                                    tmp.Update()
                                    tmplist.Update()
                                Case "date"
                                    tmplist.Fields.Add(campo.Attributes("name").Value, SPFieldType.DateTime, IIf(campo.Attributes("Requerido").Value = "True", True, False))
                                    tmplist.Update()
                                    Dim dt As SPFieldDateTime = tmplist.Fields(campo.Attributes("name").Value)
                                    dt.DisplayFormat = SPDateTimeFieldFormatType.DateOnly
                                    dt.Update()
                                Case "datetime"
                                    tmplist.Fields.Add(campo.Attributes("name").Value, SPFieldType.DateTime, IIf(campo.Attributes("Requerido").Value = "True", True, False))
                                    tmplist.Update()
                                Case "calculated"
                                    tmplist.Fields.Add(campo.Attributes("name").Value, SPFieldType.Calculated, IIf(campo.Attributes("Requerido").Value = "True", True, False))
                                    tmplist.Update()
                                    Dim dt As SPFieldCalculated = tmplist.Fields(campo.Attributes("name").Value)
                                    dt.Formula = campo.Attributes("field").Value
                                    dt.Update()
                                Case "boolean"
                                    tmplist.Fields.Add(campo.Attributes("name").Value, SPFieldType.Boolean, IIf(campo.Attributes("Requerido").Value = "True", True, False))
                                    tmplist.Update()
                                Case "percent"
                                    tmplist.Fields.Add(campo.Attributes("name").Value, SPFieldType.Number, IIf(campo.Attributes("Requerido").Value = "True", True, False))
                                    tmplist.Update()
                                    Dim dt As SPFieldNumber = tmplist.Fields(campo.Attributes("name").Value)
                                    dt.ShowAsPercentage = True
                                    dt.Update()
                            End Select
                            With tmplist.Fields(campo.Attributes("name").Value)
                                Try
                                    .Required = IIf(campo.Attributes("Requerido").Value = "True", True, False)
                                Catch
                                    .Required = False
                                End Try
                                .Update()
                            End With
                        End If
                        bPrimerCampo = False
                    Next
                    curSite.Update()
                End If

            Next
        End Sub

        Public Sub New()

        End Sub
    End Class
End Namespace
